home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / therm.exe / THERM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-10  |  2.6 KB  |  94 lines
  1. UNIT therm;
  2. INTERFACE
  3. USES Views;
  4.  
  5. procedure Thermometer (Title            : VIEWS.TTitleStr;
  6.                        Current, Total   : LongInt;
  7.                        Abort            : boolean);
  8.  
  9. {*******************************************************}
  10. {*******************************************************}
  11. {*******************************************************}
  12. IMPLEMENTATION
  13. USES APP, DIALOGS, Objects;
  14.  
  15.  
  16.  
  17.  
  18.  
  19. {**************************************************************}
  20. {* returns a string filled with the character specified       *}
  21. {**************************************************************}
  22. function Fill_String(Len : Byte; Ch : Char) : String;
  23. var
  24.   S : String;
  25. begin
  26.   IF (Len > 0) THEN
  27.     BEGIN
  28.       S[0] := Chr(Len);
  29.       FillChar(S[1], Len, Ch);
  30.       Fill_String := S;
  31.     END
  32.   ELSE Fill_String := '';
  33. end; { FillString }
  34.  
  35.  
  36. procedure Thermometer (Title            : VIEWS.TTitleStr;
  37.                        Current, Total   : LongInt;
  38.                        Abort            : boolean);
  39. const
  40.   Therm_Ptr  : PDialog = nil;
  41.   Therm_Line : PStaticText = nil;
  42. VAR
  43.   Num_Blocks : integer;   {0,1..20}
  44.   Temp_Str   : string;
  45.   R          : TRect;
  46. begin
  47.   IF (Abort) THEN
  48.     BEGIN
  49.       IF (Therm_Ptr <> NIL) THEN
  50.         BEGIN
  51.           Desktop^.Delete (Therm_Ptr);
  52.           Dispose (Therm_Ptr, DONE);
  53.           Therm_Ptr := NIL;
  54.         END;
  55.     END
  56.  
  57.   ELSE
  58.     BEGIN
  59.       {*-------------------------------------------------------------*}
  60.       {* determine how many of the 20 blocks to fill in              *}
  61.       {*-------------------------------------------------------------*}
  62.       IF (Total = 0)
  63.         THEN Exit;
  64.       IF (Current > Total)
  65.         THEN Current := Total;
  66.       Num_Blocks := (((Current*100) DIV Total) DIV 5);
  67.       Temp_Str := Fill_String (Num_Blocks, chr(8)) +
  68.                   Fill_String (20-Num_Blocks, chr(176));
  69.  
  70.       IF (Therm_Ptr = NIL) THEN
  71.         BEGIN
  72.           R.Assign (25,12,54,17);
  73.           Therm_Ptr := New (PDialog,Init (R,Title));
  74.           Therm_Ptr^.Flags := 0;
  75.           R.Assign (5,1,28,2);
  76.           Therm_Ptr^.Insert(New (PStaticText,
  77.                                  Init (R,'5        50       100%')));
  78.  
  79.           R.Assign (5,2,28,3);
  80.           Therm_Line := New (PStaticText, Init (R,Temp_Str));
  81.           Therm_Ptr^.Insert (Therm_Line);
  82.           DeskTop^.Insert (Therm_Ptr);
  83.        END
  84.  
  85.       ELSE
  86.         BEGIN
  87.            Therm_Line^.Text^ := Temp_Str;
  88.            Therm_Line^.DrawView;
  89.         END;
  90.     END; {if}
  91.  
  92. end; {thermometer}
  93.  
  94. end. {unit therm}